(READMAC MACRO
(NLAMBDA (F)
    ; TURNS MACRO-CHARS ON WHILE DOING THING;
    ; (READMAC <A-LIST> <THING-TO-DO>);
    ; <A-LIST> HAS PAIRS OF CHAR AND (QUOTED) FUNCTION;
    (COND
     ((CADR F)
      (LET
       (CHAR (CAAADR F) FN (CDAADR F))
       (RPLACO
        F
        'LET
        @
        ((SYNTAX (STATUS SYNTAX =CHAR)
                 FNTYP
                 (FNTYP '=CHAR)
		 OLD
		 (GET '=CHAR FNTYP))
         (PROG2 (SSTATUS MACRO =CHAR =FN)
                (READMAC = (CDADR F) , (CDDR F))
		(FUNCALL 'SSTATUS 'SYNTAX '=CHAR SYNTAX)
		(AND FNTYP (PUTPROP '=CHAR OLD FNTYP))
		; SET STATUS AND RESET AFTERWARDS;)))))
    ; DO THING WITH READ OR READLIST;
    ((RPLACO F (CAADDR F) (CDADDR F))))))


(LET MACRO
(NLAMBDA (F)
    (COND ((CADR F) (RPLACA F 'LET1))
	  ((CDDDR F) (RPLACO F 'PROGN (CDDR F)))
	  ((RPLACO F (CAADDR F) (CDADDR F))))))


(LET1 MACRO
(NLAMBDA (F)
    ((LAMBDA (V)
	 (COND
	  ((NULL (CDDR V))
	   (RPLACO F
		   (CONS 'LAMBDA (CONS (LIST (CAR V)) (CDDR F)))
		   (LIST (CADR V))))
          (V (RPLACO
	      F
	      (CONS 'LAMBDA
		    (CONS (LIST (CAR V))
			  (LIST
			   (CONS 'LET1 (CONS (CDDR V) (CDDR F))))))
	      (LIST (CADR V))))))
     (CADR F))))

(QU* MACRO
(NLAMBDA (X)
    ; LISTS WITH EV OR EV* ARE EVALUATED;
    ; AND THEIR RESULTS WILL BE CONSED;
    ; OR APPENDED RESPECTIVELY;
    ((LAMBDA (Y) (RPLACO X (CAR Y) (CDR Y))) (QU*1 (CADR X)))))

(QU*1 EXPR
(LAMBDA (X)
    (COND
     ((NULL X) NIL)
     ((ATOM X) (LIST 'QUOTE X))
     ((EQ (CAR X) 'EV) (CADR X))
     ((OPTIM
       (COND
	((ATOM (CAR X))
	 (LIST 'CONS (LIST 'QUOTE (CAR X)) (QU*1 (CDR X))))
        ((EQ (CAAR X) 'EV*)
	 (LIST 'APPEND (CADAR X) (QU*1 (CDR X))))
	((LIST 'CONS (QU*1 (CAR X)) (QU*1 (CDR X))))))))))

(OPTIM EXPR
(LAMBDA (X)
    ; ELIMINATES UNNECESSARY FN-CALLS;
    (SELECTQ (CAR X)
       (CONS
	; (CONS X (LIST ---)) => (LIST X ---);
	(COND
	 ((CADDR X)
	  (AND (EQ (CAADDR X) 'LIST)
	       (SETQ X (CONS 'LIST (CONS (CADR X) (CDADDR X))))))
	 ((SETQ X (LIST 'LIST (CADR X))))))
       (APPEND
	; (APPEND X (APPEND ---)) => (APPEND X ---);
	(COND
	 ((CADDR X)
	  (AND (EQ (CAADDR X) 'APPEND)
	       (SETQ X (CONS 'APPEND (CONS (CADR X) (CDADDR X))))))
	 ((SETQ X (CADR X)))))
       NIL)
    (AND (CATCH (MAPC '(LAMBDA (ARG)
			   (COND ((ATOM ARG) (THROW NIL))
				 ((EQ (CAR ARG) 'QUOTE))
				 ((THROW NIL))))
		       (CDR X)))
	 (SETQ X (LIST 'QUOTE (EVAL X)))
	 ; F IS-IN (APPEND CONS LIST);
	 ; (F 'A 'B ---) => 'VALUE;
	 ; WHERE VALUE = (EVAL (F 'A 'B ---));)
    X))




					SEND MORE USEFUL FUNCTIONS)